Pascal Super Library/Pascal Super Library (CW International)(1997).bin/COMM/RPL60/RPLMAT.INC

Text File | 1992-12-31 | 5KB | 143 lines

  {*}
  {*source code copyright (c) 1985, by TurboPower Software*}
  {*}
  {*}

  function Match(var Lin : Line; Pat : PatPtr) : Boolean;
    {-find a match anywhere in the line}
  var
    i, lPos, TagNum : Integer;
    TagOn          : Boolean;

    function aMatch(var Lin : Line; OffSet : Integer; Pat : PatPtr) : Integer;
      {-look for match of pattern list starting at pat with lin.val[offset...]}
      {-return the last position that matched}
    var
      i, k           : Integer;
      j              : PatPtr;
      Done, Junk     : Boolean;
      tTok           : Tokens;

      function oMatch(var Lin : Line; var i : Integer; Pat : PatPtr) : Boolean;
        {-match one pattern element at pattern pointed to by pat, lin.val[i]}
      var
        Advance        : -1..255;
        tTok           : Tokens;
        k              : Integer;
        c              : Char;
      begin                       {omatch}
        Advance := -1;
        tTok := Pat^.Tok;
          if IgnoreCase then c := UpCaseMac(Lin.Val[i]) else c := Lin.Val[i];
        if c <> EndStr then begin
          if tTok = tLitChar then begin
            if c = Pat^.One then Advance := 1;
          end else if tTok = tCcl then begin
            k := Pos(c, Pat^.StrPtr^);
            if k > 0 then Advance := 1;
          end else if tTok = tnCcl then begin
            if (c <> #13) and (c <> #10) then begin
              k := Pos(c, Pat^.StrPtr^);
              if k = 0 then Advance := 1;
            end;
          end else if tTok = tAny then begin
            if (c <> #13) and (c <> #10) then Advance := 1;
          end else if tTok = tBol then begin
            if i = 1 then Advance := 0;
          end else if tTok = tEol then begin
            if (c = #13) and (Lin.Val[Succ(i)] = #10) then Advance := 0;
          end else if tTok = tNil then begin
            Advance := 0;
          end else if tTok = tbTag then begin
            Advance := 0;
            if not(TagOn) then begin
              TagNum := Succ(TagNum);
              TagOn := True;
            end;
          end else if tTok = teTag then begin
            Advance := 0;
            TagOn := False;
          end else if tTok = tGroup then begin
            {we treat a group as a "character", but allow advance of multiple chars}
            {recursive call to amatch}
            k := aMatch(Lin, i, Pat^.NestPtr);
            if k >= i then begin
              i := k;
              Advance := 0;
            end;
          end;
        end else begin
          {at end of line}
          {end tag marks match}
          if (tTok = teTag) then Advance := 0;
        end;

        if Advance >= 0 then begin
          {ignore tag words here, since they are not used}
          oMatch := True;
          i := i+Advance;
        end else
          oMatch := False;

      end;                        {omatch}

    begin                         {amatch}
      Done := False;
      j := Pat;
      while not(Done) and (j <> nil) do begin
        tTok := j^.Tok;
        if tTok = tClosure then begin
          {a closure}
          j := j^.Next;           {step past the closure in the pattern list}
          i := OffSet;            {leave the current line position unchanged}
          {match as many as possible}
          while not(Done) and (Lin.Val[i] <> EndStr) do begin
            if not(oMatch(Lin, i, j)) then Done := True;
          end;
          {i points to the location that caused a non-match}
          {match rest of pattern against rest of input}
          {shrink closure by one after each failure}
          Done := False;
          while not(Done) and (i >= OffSet) do begin
            {call amatch recursively}
            k := aMatch(Lin, i, j^.Next);
              if k > 0 then Done := True else i := Pred(i);
          end;
          OffSet := k;            {if k=0 then failure else success}
          Done := True;
        end else if tTok = tMaybeOne then begin
          {a 0 or 1 closure}
          j := j^.Next;           {step past the closure marker}
          {match or no match is ok, but advance lin cursor if matched}
          Junk := oMatch(Lin, OffSet, j);
          {advance to the next pattern token}
          j := j^.Next;
        end else if not(oMatch(Lin, OffSet, j)) then begin
          if j^.NexTok then begin
            {we get another chance because of alternation}
            j := j^.Next;
          end else begin
            {omatch failed, can't back up}
            OffSet := 0;
            Done := True;
          end;
        end else begin            {omatch succeeded}
          {skip over alternates if we matched already}
          while j^.NexTok and (j^.Next <> nil) do j := j^.Next;
          {move to the next non-alternate}
          j := j^.Next;
        end;
      end;
      aMatch := OffSet;
    end;                          {amatch}

  begin                           {match}
    lPos := 0; i := 1; TagNum := 0; TagOn := False;
    while (Lin.Val[i] <> EndStr) and (lPos = 0) do begin
      lPos := aMatch(Lin, i, Pat);
      Match := (lPos > 0);
      i := Succ(i);
    end;
  end;                            {match}